;;(load "rd.scm")
;;(load "num.scm")
;;(load "sym.scm")
(define char-name-str-list '("space" "newline" "tab" "空格" "回车" "制表符"))
(define cyl-defined-system-language '("c" "lisp" "scheme" "python" "c++" "asm" "elisp" "java"))
(define cyl-defined-system-value '("nil" "true" "false" "found" "notfound" "error" "unknown" "correct" "limited" "unlimited" "infinite" "infinitesimals" "default"
				   "空" "真" "假" "含" "不含" "错" "未知" "对" "有限" "无限" "无穷大" "无穷小" "未找到" "系统缺省值"
				   ))
(define cyl-defined-system-handling '("错误处理"
				      ))
(define (rd-bin c)(or (char=? c #\0)(char=? c #\1)))
(define (rd-oct c)(and (char>=? c #\0)(char<=? c #\7)))
(define (rd-hex c)(or (rd-digit c)(and (char>=? c #\a)(char<=? c #\f))(and (char>=? #\A)(char<=? c #\F))))
(define (rd-dec c)(rd-digit c))

(define (get-system-num s m n f)
  (let* ((len (string-length s))
	(c (if (< n len) (string-ref s n)))
        )
    (cond
     ((or (= n len)(rd-all-deli c)(char=? c #\、))
      (substring s m n))
     ((and (< n len)(f c))
      (get-system-num s m (+ n 1) f))
     (else (list 'err n '非法常量 (format "[~a]不是规定的进制字符。" c))))))
(define (get-bin s n)(get-system-num s n n rd-bin))
(define (get-oct s n)(get-system-num s n n rd-oct))
(define (get-hex s n)(get-system-num s n n rd-hex))
(define (get-dec s n)(get-system-num s n n rd-dec))
(define (get-str s n)
  (let ((str ""))
    (if (char=? (string-ref s n) #\")
	(begin
	  (set! str (rd-match-slash-in s (+ n 1) #\"))
	  (if str
	      (begin
		(set! str (string-append "\"" str))
		(list str  (- (+ (string-length str) n) 1) '字符串))
	      (list 'err (string-length s) '非法常量  (err-format "[~a]处开始的字符串常量未找到匹配引号" n)))))))

(def/err (get-cons s n)
  (if (char=? (string-ref s n) #\#)
      (let* ((i (+ n 1))
             (c (string-ref s i))
             (st '常量引导符)
	     (str-len 0)
	     (len (string-length s))
             )
	;;(y-or-n "get-cons:c=~a,i=~a\n" c i)
        (cond
          ((char=? c #\\)
           (set! st '字符常量引导符)
	   (if (< (+ i 1) len)
           (let* ((res (get-符号 s (+ i 1) (+ i 1) '开始))(str (nth 0 res))(l (nth 1 res))(cur-st (nth 2 res)))
	     ;;(y-or-n "get-cons:res=~a\n" res)
             (if (and (string? str) (or (= (string-length str) 1) (member str char-name-str-list)))
                 (begin
                   (set! str (string-append "#\\" str))
                   (list str l '字符常量))
		 (let ((c1 (string-ref s (+ i 1))))
		   (list (string-append "#\\" (string c1)) (+ i 1) '字符常量))
		     ))
	    (list 'err len '非法常量 (err-format "文件末尾字符常量不合法。")))
	   )
          ((char=? c #\")
           (set! st '字符串常量引导符)
           (let* ((res (run/err get-str s i))(str (nth 0 res))(i (nth 1 res))(st (nth 2 res)))
             (if str
                 (list (string-append "#" str) i '字符串常量)
                 (list 'err i '非法常量 '未找到匹配的引号))))
	  ((char=? c #\&)
           (set! st '系统语言常量引导符)
           (let* ((res (run/err get-sym s (+ i 1)))(str (nth 0 res))(i (nth 1 res))(st (nth 2 res)))
             (if (and str (eq? st '词语)(member str cyl-defined-system-language))
                 (list (string-append "#&" str) i '系统语言常量)
                 (list 'err i '非法常量 '未定义系统语言常量))))
	  ((char=? c #\%)
           (set! st '系统值常量引导符)
           (let* ((res (run/err get-sym s (+ i 1)))(str (nth 0 res))(i (nth 1 res))(st (nth 2 res)))
             (if (and str (eq? st '词语)(member str cyl-defined-system-value))
                 (list (string-append "#%" str) i '系统值常量)
                 (list 'err i '非法常量 '未定义系统值常量))))
	   ((char=? c #\$)
	    (set! st '系统处理常量引导符)
	    (let* ((res (run/err get-sym s (+ i 1)))(str (nth 0 res))(i (nth 1 res))(st (nth 2 res)))
	      (if (and str (eq? st '词语)(member str cyl-defined-system-handling))
		  (list (string-append "#$" str) i '系统处理常量)
		  (list 'err i '非法常量 '未定义系统处理常量))))
	   ((char=? c #\')
	    (set! st '扩展常量引导符)
	    (let* ((res (run/err get-sym s (+ i 1)))(str (nth 0 res))(i (nth 1 res))(st (nth 2 res)))
	      (if (and str (eq? st '词语))
		  (list (string-append "#'" str) i '扩展常量)
		  (list 'err i '非法常量 '非法扩展常量))))
	   ((char=? c #\^)
	    (set! st '系统变量常数引导符)
	    (let* ((res (run/err get-sym s (+ i 1)))(str (nth 0 res))(i (nth 1 res))(st (nth 2 res)))
	      (if (and str (eq? st '词语))
		  (list (string-append "#^" str) i '系统变量常数)
		  (list 'err i '非法常量 '非法系统变量常数))))
          ((char=? c #\b)
           (set! st '二进制常数引导符)
           (let ((str (get-bin s (+ i 1))))
             (if (string? str)
                 (list (string-append "#b" str) (+ (string-length str) n 1) '二进制常数)
                 (list 'err i '非法常量 '错误二进制常数))))
          ((char=? c #\o)
           (set! st '八进制常数引导符)
           (let ((str (get-oct s (+ i 1))))
             (if (string? str)
                 (list (string-append "#o" str) (+ (string-length str) n 1) '八进制常数)
                 (list  'err i '非法常量  '错误八进制常数))))
          ((char=? c #\x)
           (set! st '十六进制常数引导符)
           (let ((str (get-hex s (+ i 1))))
             (if (string? str)
                 (list (string-append "#x" str) (+ (string-length str) n 1) '十六进制常数)
                 (list 'err i '非法常量 '错误十六进制常数))))
	  ((char=? c #\d)
           (set! st '十进制常数引导符)
           (let ((str (get-dec s (+ i 1))))
             (if (string? str)
                 (list (string-append "#d" str) (+ (string-length str) n 1) '十进制常数)
                 (list 'err i '非法常量 '错误十进制常数))))
	  ((char=? c #\*)
           (set! st '存储长度引导符)
           (let ((str (get-dec s (+ i 1))))
             (if (string? str)
                 (list (string-append "#*" str) (+ (string-length str) n 1) '存储长度)
                 (list 'err i '非法常量 '错误存储长度))))
          ((char=? c #\#)
           (set! st '单行注释引导符)
           (let ((str (run/err rd-match-not s (+ i 1) #\newline)))
             (if str
                 (list (string-append "##" str) (+ (string-length str) n 1) '单行注释)
                 (list 'err i '非法常量 '错误单行注释))))
          ((char=? c #\!)
           (set! st '开发注释引导符)
           (let ((str (run/err rd-match-not s (+ i 1) #\newline)))
             (if str
                 (list (string-append "#!" str) (+ (string-length str) n 1) '开发注释)
                 (list 'err i '非法常量  '错误开发注释))))
          ((char=? c #\<)
           (set! st '多行注释引导符)
           (let ((str (run/err rd-match2-in s (+ i 1) #\# #\>)))
             (if str
                 (list (string-append "#<" str) (+ (string-length str) n 1) '多行注释)
                 (list 'err i '非法常量 '错误多行注释))))
	  (else (let* ((res (run/err get-sym s i))(str (nth 0 res))(l (nth 1 res))(cur-st (nth 2 res)))
                  (cond
                    ((and str (eq? cur-st '整数))
                     (list (string-append "#" str) l '十进制常数))
                    ((and str (eq? cur-st '词语))
                     (list (string-append "#" str) l '扩展常量))
                    ((and str (or (eq? cur-st '小数)(eq? cur-st '分数)(eq? cur-st '指数数)))
                     (list 'err l '非法常量 '错误十进制常数))
                    (else (list 'err l '非法常量 '错误扩展常量)))))
          ))
      (list 'err i '非法常量 (format "[~a]未定义，非法#常量。" (string c)))))
             
             
           
        
